home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / vis082s.arc / MAINMENU.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-04-18  |  5.5 KB  |  196 lines
  1. {$R-,S-,I-,D-,F+,V-,B-,N-,L+,O+ }
  2.  
  3. unit mainmenu;
  4.  
  5. interface
  6.  
  7. uses crt,dos,
  8.      gentypes,configrt,statret,textret,userret,mailret,
  9.      gensubs,subs1,subs2,windows,
  10.      chatstuf,mainr1,mainr2,overret1;
  11.  
  12. procedure summonsysop;
  13. procedure offtheforum;
  14.  
  15. implementation
  16.  
  17.  
  18. procedure summonsysop;
  19. var tf:text;
  20.     emt:boolean;
  21.     k:char;
  22.     a,b,c,d:sstr;
  23. begin
  24.   c:='ZR';
  25.   chatmode:=not chatmode;
  26.   bottomline;
  27.   b:='vi';
  28.   emt:=sysopisavail;
  29.   a:='eP';
  30.   d:=b+c+a+'!';
  31.   if not chatmode then begin
  32.       unsplit;
  33.       chatreason:='';
  34.       writeln(^M'Page off. Use [C] to turn it back on.');
  35.       exit;
  36.       end
  37.   else
  38.     if not sysopisavail then begin
  39.          writestr(^M^P'The SysOp is not here, is this an '^R'Emergency'^P'? *');
  40.          if yes then begin
  41.                      dots:=true;
  42.                      writestr(^M^P'Enter the '^R'EMERGENCY'^P' Chat Password : *');
  43.                      dots:=false;
  44.                                          if match(input,d) then emt:=true;
  45.                      if match(input,configset.emchatp) then emt:=true else
  46.                          Begin
  47.                              Inc(HackAttempts);
  48.                              chatmode:=false;
  49.                              DoHackShit;
  50.                              If HackAttempts=1 then WriteLn(^M^S'Nice Try!'^G);
  51.                              Exit;
  52.                          End;
  53.                  end;
  54.          end;
  55.             if emt
  56.                 then
  57.                     begin
  58.                         writestr (^M'Enter a short reason: &');
  59.                         chatreason:=input;
  60.                         if length(input)=0 then begin
  61.                             chatmode:=false;
  62.                             exit
  63.                         end;
  64.                         bottomline;
  65.                         writelog (1,3,chatreason);
  66.                         assign (tf,configset.textfiledi+'Summon');
  67.                         reset (tf);
  68.                         if ioresult=0 then begin
  69.                             while (not (eof(tf) or hungupon)) and chatmode do
  70.                                 begin
  71.                                     read (tf,k);
  72.                                     nobreak:=true;
  73.                                     if ord(k)=7 then summonbeep else writechar (k);
  74.                                     if keyhit then begin
  75.                                         k:=bioskey;
  76.                                         clearbreak;
  77.                                         bustchat;
  78.                                     end
  79.                                 end;
  80.                             textclose (tf)
  81.                         end;
  82.                         if chatmode
  83.                             then writestr (^M'Use [C] again to turn off page.')
  84.                     end
  85.                 else
  86.                     begin
  87.                     writeln (^M^P'Sorry, '^R,configset.sysopnam,^P' isn''t available right now!');
  88.             chatmode:=false;
  89.             writelog (1,2,'')
  90.           end;
  91.   clearbreak;
  92. end;
  93.  
  94. procedure offtheforum;
  95. var q,n:integer;
  96.     tn:file of integer;
  97.     m:message;
  98.     me:mailrec;
  99.     totaltrans:longint;
  100.  
  101. Procedure SendFeedBack;
  102. Begin
  103.   me.Line:=Editor(m,false,true,'The SysOp''s','0');
  104.   if me.Line>0 then Begin
  105.     Me.SentBy:=Unam;
  106.     Me.Title:='Log Off Feedback from '+Unam;
  107.     Me.Anon:=False;
  108.     Me.When:=Now;
  109.     AddFeedBack(Me);
  110.   End;
  111. End;    (* End Procedure *)
  112.  
  113. procedure famousdays;
  114. var mo,da,yr:string[10];
  115.     i:integer;
  116.     todm,todd,tod:string[10];
  117.     tempstr:string[80];
  118.     fn:text;
  119.     ext:string[3];
  120.  
  121. begin
  122.      if not configset.famday then exit;
  123.      tod:=datestr(now);
  124.      todm:=copy(tod,0,2);          i:=2;
  125.      if pos('/',todm)>0 then begin i:=1;tempstr:='0'+todm[1];todm:=tempstr;end;
  126.      todd:=copy(tod,2+i,2);  i:=1;
  127.      if pos('/',todd)>0 then begin tempstr:='0'+todd[1]; todd:=tempstr; end;
  128.         tod:=copy(datestr(now),length(datestr(now))-1,2);
  129.         case valu(todm) of
  130.          1:ext:='Jan';
  131.          2:ext:='Feb';
  132.          3:ext:='Mar';
  133.          4:ext:='Apr';
  134.          5:ext:='May';
  135.          6:ext:='Jun';
  136.          7:ext:='Jul';
  137.          8:ext:='Aug';
  138.          9:ext:='Sep';
  139.          10:ext:='Oct';
  140.          11:ext:='Nov';
  141.          12:ext:='Dec';
  142.      end;
  143.      If Not Exist(ConfigSet.TextFileDi+'TODAY.'+Ext) then Exit;
  144.      assign(fn,configset.textfiledi+'TODAY.'+ext);
  145.      reset(fn); writeln(^M);
  146.      while not eof(fn) do begin
  147.       readln(fn,tempstr);
  148.       if pos('Birthday',tempstr)>0 then writeln(^P'Famous birthdays for '^S,ext,' ',todd,', 19',tod,^M^R);
  149.       if pos('Events',tempstr)>0 then writeln(^M^M^P'Famous Events for '^S,ext,' ',todd,', 19',tod,^M^R);
  150.          mo:=copy(tempstr,2,2);
  151.          da:=copy(tempstr,4,2);
  152.          yr:=copy(tempstr,6,4);
  153.          if yr='    ' then yr:='19'+tod;
  154.          if (mo=todm) and (da=todd) then writeln(^U,ext,' ',todd,', ',yr,'... ',^R,copy(tempstr,11,60));
  155.       end;
  156. textclose(fn);
  157. end;
  158.  
  159. begin
  160.   writestr (^R'Leave '^S+configset.shortnam+^R' now? '^P'['^A'N'^P']:');
  161.   if yes then begin
  162.   If exist(configset.forumdi+'LOGOFF.BAT') Then
  163.     exec(getenv('COMSPEC'), '/C LOGOFF.BAT');
  164.   if ulvl>=configset.msg2nx then begin
  165.     writestr (^R'Leave message to next user? '^P'['^A'N'^P']:');
  166.     if yes then begin
  167.       q:=editor(m,false,false,'0','0');
  168.       if q>=0 then begin
  169.         if tonext>=0 then deletetext (tonext);
  170.         tonext:=q;
  171.         end
  172.       end;
  173.     end;
  174.     WriteStr(^R'Leave a Message to the SysOp? '^P'['^A'N'^P']:');
  175.     If Yes then SendFeedBack;
  176.         totaltrans:=totalsent+totalrece;
  177.         famousdays;
  178.         Writehdr('Logoff Statistics');
  179.         WriteLn(^S'Board Name'^P'.............'^S':'^A' '+configset.longnam);
  180.         WriteLn(^S'SysOp Name'^P'.............'^S':'^A' '+configset.sysopnam);
  181.         writeln(^S'You Were Caller #'^P'......'^S':'^A' ',streal(numcallers));
  182.         writeln(^S'You Have Called'^P'........'^S':'^A' ',strr(urec.numon)+' Times');
  183.         WriteLn(^S'Total Bytes Sent'^P'.......'^S':'^A' ',TotalSent);
  184.         WriteLn(^S'Total Bytes Received'^P'...'^S':'^A' ',totalrece);
  185.         WriteLn(^S'Total Bytes Transferred'^S':'^A' ',totaltrans);
  186.         WriteLn(^S'Logoff Time'^P'............'^S':'^A' ',timestr(now));
  187.         WriteLn(^S'Logoff Date'^P'............'^S':'^A' ',datestr(now));
  188.     printfile (configset.textfiledi+'GoodBye');
  189.     disconnect
  190.   end
  191. end;
  192.  
  193.  
  194. begin
  195. end.
  196.